home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / DBLCLICK.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  2KB  |  68 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program DblClick;
  10.  
  11. uses WinTypes, WinProcs, WObjects;
  12.  
  13. type
  14.   TApp = object(TApplication)
  15.     procedure InitMainWindow; virtual;
  16.   end;
  17.  
  18.   PMyWindow = ^TMyWindow;
  19.   TMyWindow = Object(TWindow)
  20.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  21.     procedure Paint(PaintDC: HDC; var PaintInfo :TPaintStruct); virtual;
  22.     function  GetClassName: PChar; virtual;
  23.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  24.     procedure DblClk(var Message: TMessage);
  25.       virtual wm_lButtonDblClk;
  26.   end;
  27.  
  28. procedure TApp.InitMainWindow;
  29. begin
  30.   MainWindow := New(PMyWindow, Init(Nil, 'Double Click'));
  31. end;
  32.  
  33. constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  34. begin
  35.   TWindow.Init(AParent, ATitle);
  36. end;
  37. procedure TMyWindow.Paint(PaintDC: HDC; var PaintInfo :TPaintStruct);
  38. begin
  39.   TWindow.Paint(PaintDC, PaintInfo);
  40.   TextOut(PaintDC, 30, 30, 'Please Double Click in the Client Region'#0,
  41.     40);
  42. end;
  43.  
  44. function TMyWindow.GetClassName: PChar;
  45. begin
  46.   GetClassName := 'DoubleClickDemoWindow';
  47. end;
  48.  
  49. procedure TMyWindow.GetWindowClass(var AWndClass: TWndClass);
  50. begin
  51.   TWindow.GetWindowClass(AWndClass);
  52.   AWndClass.Style := AWndClass.Style or cs_DblClks;
  53. end;
  54.  
  55. procedure TMyWindow.DblClk(var Message: TMessage);
  56. begin
  57.   MessageBox(HWindow, 'Double Click', 'Message', mb_Ok);
  58. end;
  59.  
  60. var
  61.   App: TApp;
  62.  
  63. begin
  64.   App.Init('DblClick');
  65.   App.Run;
  66.   App.Done;
  67. end.
  68.